home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Aminet 2
/
Aminet AMIGA CDROM (1994)(Walnut Creek)[Feb 1994][W.O. 44790-1].iso
/
Aminet
/
dev
/
lang
/
false11.lha
/
False_v1.1
/
false.s
< prev
next >
Wrap
Text File
|
1992-09-02
|
6KB
|
377 lines
; FALSE compiler in a 1020 bytes executable!
; Wouter van Oortmerssen, 1993, v1.1
; - fixed free twice bug in v1.0
maxsource = 25000
maxcode = 30000
maxmem = maxsource+maxcode+5000
k: clr.b -1(a0,d0.w)
move.l a0,d5 ; d5=temparg
move.l 4.w,a6
moveq #0,d1
moveq #1,d0
swap d0 ; move.l #maxmem,d0
jsr -684(a6) ; allocvec
move.l d0,d6 ; d6=tempmem
beq nfrer
move.l d6,a2 ; a2=mem
move.l d6,a4 ; a4=code
lea maxsource(a4),a4
move.l a4,d7 ; d7=begin_of_code
lea maxcode(a4),a3 ; a3=lambda-stack
lea dosn(pc),a1
moveq #37,d0
jsr -552(a6) ; opendoslib
tst.l d0
beq.w ncler
move.l d0,a6 ; a6=dosbase
move.l d5,d1
move.l #1005,d2
jsr -30(a6) ; open(arg)
tst.l d0
beq.w er
move.l d0,d5 ; d5=temphandle
move.l d0,d1
move.l d6,d2
move.l #maxsource,d3
jsr -42(a6) ; readfile
move.l d0,d6
move.l d5,d1
jsr -36(a6) ; close
cmp.w #1,d6
bmi.w er
add.l d2,d6 ; d6=end_of_source
move.l d2,a5 ; a5=source
lea initc(pc),a0
lea inite(pc),a1
bsr copy
loop: cmp.l d6,a5 ; main loop
bpl.w done
moveq #0,d0
move.b (a5)+,d0
cmp.w #"0",d0
bpl.w num
numb: cmp.w #"[",d0 ; lambda
bne.s .1
move.l #$41fa0008,(a4)+ ; lea ...(pc),a0
move.w #$2b08,(a4)+ ; move.l a0,-(a5)
move.l #$6000fff8,(a4)+ ; bra ...
move.l a4,(a3)+
bra.s loop
.1: cmp.w #"]",d0 ; end of lambda
bne.s .2
move.w #$4e75,(a4)+
move.l -(a3),a0
move.l a4,d0
sub.l a0,d0
addq.l #2,d0
move.w d0,-2(a0)
bra.s loop
.2: cmp.w #"a",d0 ; variable
bpl.w var
varb: cmp.w #" "+1,d0
bmi.s loop
cmp.w #"{",d0
bne.s .1
.l: cmp.l d6,a5 ; collect comments
bpl.w done
cmp.b #"}",(a5)+
bne.s .l
bra.s loop
.1: cmp.w #34,d0
bne.s .2
move.l #$41fa0006,(a4)+ ; gen code for string
move.l #$60000000,(a4)+
move.l a4,a0
.l2: cmp.l d6,a5
bpl.s .f
cmp.b #34,(a5)
beq.s .f
move.b (a5)+,(a4)+
bra.s .l2
.f: addq.l #1,a5
clr.b (a4)+
move.l a4,d0
btst #0,d0
beq.s .even
clr.b (a4)+
.even: move.l a4,d0
sub.l a0,d0
addq.l #2,d0
move.w d0,-2(a0)
move.l #$22084eae,(a4)+
move.w #$fc4c,(a4)+
bra.w loop
.2: cmp.w #"'",d0 ; ascii
bne.s .3
moveq #0,d0
move.b (a5)+,d0
move.w #$2b3c,(a4)+
move.l d0,(a4)+
bra.w loop
.3: cmp.w #"`",d0 ; inline assembler :-)
bne.s .4
move.l -(a4),d0
subq.l #2,a4
move.w d0,(a4)+
bra.w loop
.4:
lea plus(pc),a0
search: cmp.b 2(a0),d0 ; generate code for symbol
bne.s next
addq.l #3,a0
moveq #0,d1
move.b (a0)+,d1
.cl: move.w (a0)+,(a4)+
dbra d1,.cl
bra.w loop
next: move.w (a0),d1
beq.w er
add.w d1,a0
bra.s search
done: lea exitc(pc),a0
lea exite(pc),a1
bsr copy
move.l a4,d0 ; ready, now write executable.
btst #1,d0
beq.s .s
clr.w (a4)+
.s: move.l a4,d0
sub.l d7,d0
sub.l #32,d0
lsr.l #2,d0
move.l #1010,(a4)+ ; hunk_end
move.l d7,a0
move.l d0,20(a0) ; hunk lenght
move.l d0,28(a0)
lea exen(pc),a0
move.l a0,d1 ; now write exe
move.l #1006,d2
jsr -30(a6) ; open
move.l d0,d4
beq er
move.l d0,d1
move.l d7,d2
move.l a4,d3
sub.l d7,d3
jsr -48(a6) ; write
move.l d4,d1
jsr -36(a6) ; close
close: move.l a6,a1
move.l 4.w,a6
jsr -414(a6)
bsr.s ncler
moveq #0,d0
rts
er: bsr.s close
bra.s nfrer
ncler: move.l a2,a1
jsr -690(a6)
nfrer: moveq #10,d0 ; error exit point
rts
num: cmp.w #"9"+1,d0 ; code gen voor num
bpl.w numb
moveq #0,d1
.l: mulu #10,d1
sub.w #"0",d0
add.l d0,d1
cmp.b #"0",(a5)
bmi.s .x
cmp.b #"9"+1,(a5)
bpl.s .x
moveq #0,d0
move.b (a5)+,d0
bra.s .l
.x: move.w #$2b3c,(a4)+ ; move.l #x,-(a5)
move.l d1,(a4)+
bra.w loop
var: cmp.w #"z"+1,d0 ; code gen voor vars
bpl.w varb
sub.w #"a",d0
lsl.w #2,d0
move.w #$41ec,(a4)+ ; lea x(a4),a0
move.w d0,(a4)+
move.w #$2b08,(a4)+ ; move.l a0,-(a5)
bra.w loop
copy: move.l a1,d0
sub.l a0,d0
lsr.l #1,d0
subq.l #1,d0
.l: move.w (a0)+,(a4)+
dbra d0,.l
rts
; code-gen list: implementation for all other symbols.
plus: dr.w min
dc.b "+",1
move.l (a5)+,d0
add.l d0,(a5)
min: dr.w mul
dc.b "-",1
move.l (a5)+,d0
sub.l d0,(a5)
mul: dr.w div
dc.b "*",3
move.l (a5)+,d0
muls 2(a5),d0
move.l d0,(a5)
div: dr.w printi
dc.b "/",4
move.l (a5)+,d0
move.l (a5),d1
divs d0,d1
ext.l d1
move.l d1,(a5)
printi: dr.w exe
dc.b ".",9
bra.s .c
.form: dc.b "%ld",0
.c: lea .form(pc),a0
move.l a0,d1
move.l a5,d2
jsr -954(a6)
addq.l #4,a5
exe: dr.w store
dc.b "!",1
move.l (a5)+,a0
jsr (a0)
store: dr.w get
dc.b ":",1
move.l (a5)+,a0
move.l (a5)+,(a0)
get: dr.w equal
dc.b ";",1
move.l (a5)+,a0
move.l (a0),-(a5)
equal: dr.w if
dc.b "=",5
move.l (a5)+,d0
cmp.l (a5),d0
seq d0
ext.w d0
ext.l d0
move.l d0,(a5)
if: dr.w dup
dc.b "?",3
move.l (a5)+,a0
move.l (a5)+,d0
beq.s .f
jsr (a0)
.f:
dup: dr.w drop
dc.b "$",0
move.l (a5),-(a5)
drop: dr.w swap
dc.b "%",0
addq.l #4,a5
swap: dr.w rot
dc.b "\",4
move.l (a5),d0
move.l 4(a5),(a5)
move.l d0,4(a5)
rot: dr.w neg
dc.b "@",7
move.l 8(a5),d0
move.l 4(a5),8(a5)
move.l (a5),4(a5)
move.l d0,(a5)
neg: dr.w and
dc.b "_",0
neg.l (a5)
and: dr.w or
dc.b "&",1
move.l (a5)+,d0
and.l d0,(a5)
or: dr.w not
dc.b "|",1
move.l (a5)+,d0
or.l d0,(a5)
not: dr.w big
dc.b "~",0
not.l (a5)
big: dr.w while
dc.b ">",5
move.l (a5)+,d0
cmp.l (a5),d0
smi d0
ext.w d0
ext.l d0
move.l d0,(a5)
while: dr.w put
dc.b "#",12
movem.l (a5)+,a0/a1 ; fun,boolf
movem.l a0/a1,-(a7)
.s: move.l 4(a7),a0
jsr (a0)
tst.l (a5)+
beq.s .e
move.l (a7),a0
jsr (a0)
bra.s .s
.e: addq.l #8,a7
put: dr.w getc
dc.b ",",3
move.l d6,d1
move.l (a5)+,d2
jsr -312(a6)
getc: dr.w pick
dc.b "^",3
move.l d5,d1
jsr -306(a6)
move.l d0,-(a5)
pick: dr.w flush
dc.b "ø",3
move.l (a5)+,d0
lsl.l #2,d0
move.l 0(a5,d0.l),-(a5)
flush: dc.w 0
dc.b "ß",5
move.l d5,d1
jsr -360(a6)
move.l d6,d1
jsr -360(a6)
exen: dc.b "a.out",0
even
; initialisation code.
initc: dc.l 1011 ; hunkheader
dc.l 0,1,0,0 ; endofnames,1hunk,firsthunkno,lasthn
dc.l 0 ; codesize/4
dc.l 1001 ; hunkcode
dc.l 0 ; codesize/4
lea -$900(a7),a5 ; a5=calcstack
lea -$800(a7),a4 ; a4=variables
move.l a0,(a4) ; var_a=arg
move.l 4.w,a6
lea dosn(pc),a1
moveq #37,d0
jsr -552(a6) ; opendoslib
tst.l d0
bne.s .o
rts
.o: move.l d0,a6
jsr -60(a6)
move.l d0,d6 ; d6=stdout
jsr -54(a6)
move.l d0,d5 ; d5=stdin
bra.s inite
dosn: dc.b "dos.library",0
inite:
exitc: move.l a6,a1
move.l 4.w,a6
jsr -414(a6)
moveq #0,d0
rts
exite: